perm filename RHYTH.F4[NEW,LCS]6 blob sn#177354 filedate 1975-06-17 generic text, type T, neo UTF8
00100	C***** SUBRS RHYTH, SETUP, MARKS, DOTS  ********
00200	
00300		SUBROUTINE RHYTH
00400		DIMENSION R(10,80),POSNT(0/81)
00500		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
00600		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00700		COMMON /SCX/RHY(4),JALPHA(22),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00800		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
00900		1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /FLM/RPOS(2,300)
01000		COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01100		1 AVP2,ZX,RE,ZZ,RD,RSTX
01200	C   SEE ALSO FILLMS, SETLET AND SETUP  RE. /FLM/
01300		COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ3
01500		EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(POSNT,RN(3801)),
01600		1(NTC,RN(3883)),(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
01700		1,(VX(8),C),(VX(9),S),(VX(10),X3),(RA,RN(3919)),(POZ1,RN(3884))
01800		1,(R,RN(3001)),(STUP,RN(3921)),(PS2,RN(3922))
01900	
01950		DATA FIB/.75/
01975	C  FIB IS FOR PSUEDO-FIBONACCI SPACING
02000		RSTJ3=RSTFAC(IFIX(STAFF))
02200		NX=-1
02300		JX=0
02400		NOTE=0
02500		Y=0
02600		JSET=0
02700	C  NEG. IF SETUP IS NOT READY
02900		IF(STUP)GO TO 341
03000		KZ=1
03100		POS2=PS2
03200	C  GETS LAST ↑↑ POS. FROM SETUP
03300		JSET=-1
03400	C  NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
03500		DO 9 KX=1,100
03600	9	IF(RPOS(2,KX).GT.0)GO TO 10
03700	10	AVGPOS=RPOS(1,KX)
03800		RLPOS=AVGPOS
03900		KX=KX+1
04000		RLP2=RPOS(1,KX)
04100	343	AVP2=RPOS(2,KX)-.001
04200		IF(AVP2.GT.0)GO TO 341
04300		KX=KX+1
04400		GO TO 343
04500	C  AVERAGED AND REAL POSITIONS FROM 'SETUP'
04600	
04700	C  NEXT FOR NON-SETUP
04800	341	DO 34 K=1,IRHY
04850		Z=ABS(V(K))
04900	CC34	IF(V(K).GT..05)Y=ABS(V(K))+Y
05000	C  88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
05010		IF(Z.NE.4./88.)GO TO 345
05055		IF(JSET)GO TO 34
05056	C  GRACE NOTES SKIPPED IN AUTOMATIC SETUP
05057	CF	Y=Y+.125
05059	CF	GO TO 34
05077	CF345	Y=ABS(V(K))+Y
05079	345	IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
05080	C  STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
05081		Y=Y+Z
05088	34	CONTINUE
05100	C  Y=TOTAL TIME
05110		POZ1=POS1
05115		POSNT(0)=POS2
05117	C A SAFEGUARD
05120	C  SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
05130		NTC=0
05140	C  THE WORD COUNT FOR REAL NOTES.
05200		IF(JSET)GO TO 3421
05300	
05400		IF(POS1.LT.POS2)POSX=POS1
05500	C  SAVES IT FOR BACKUP
05600		IF(POS1.GE.POS2)POS1=POSX
05700	
05800		Z=POS2-POS1
05900		ZX=Z
06000	342	DO 1 K=1,IZ
06100		X=R(1,K)
06200		IF(X.LT.3.)GO TO 1
06300	C  JUMP IF NOTE OR REST
06400		IF(X.NE.17.)GO TO 8
06500	C   JUMP IF NOT A KEY SIG.
06600		RA=2.+ABS(R(5,K))*2.0
06700		GO TO 6
06800	8	IF(X.NE.4.)GO TO 81
06900	C   NEXT IS FOR BAR LINES
07000		RA=3
07050		J=K+1
07100		RE=R(1,J)
07200		IF(RE.EQ.3.)RA=1.5
07300	C  A CLEF
07400		IF(RE.EQ.18)RA=2.5
07500	C  A METER
07600		IF(RE.NE.1)GO TO 83
07650		IF(AMOD(R(5,J),10.).NE.0)RA=4.5
07700	C  FINDS ACCI ON NEXT NOTE.
07800	83	IF(K.EQ.IZ)RA=0
07900	C  END OF STAFF
08000		GO TO 6
08100	82	RA=6
08200		GO TO 83
08300	81	IF(X.EQ.18)GO TO 82
08400		RA=7.
08500	C   FOR CLEFS
08600		IF(K.LT.3)RA=9.
08700	C   THE FIRST CLEF IS NOT MINI
08800	6	RA=RA*RSTJ3
08900	C  SO SPACE WILL DEPEND ON SIZE OF STAFF
09000		Z=Z-RA
09100		R(8,K)=RA
09200	C   STORES SPACE NUM THAT MUST BE GIVEN BACK
09300	1	CONTINUE
09400	C   SUBTRACTS SPACE FOR CLEF OR BAR.  WILL ADD BOTH LATER.
09500	C  POS1 AND Z ARE FOR RHYTHMIC SPACING
09700	C  SPACE FOR NON-NOTES
09800	134	FORMAT(' **** MISMATCH WITH SPACING STAFF')
09900	3421	K=0
10000		IF(ABS(Y-RA).LE..001)GO TO 3
10050		IF(JSET)TYPE 134
10100	
10200	C   LOOP TO END
10300	3	K=K+1
10400	C   K IS COUNTER
10600		R(7,K)=0
10700		RE=R(1,K)
10800		IF(RE.LE.2.)GO TO 2
10900		RD=R(8,K)
11000		R(8,K)=0
11100		IF(JSET)GO TO 71
11200	
11300	7	IF(K.EQ.IZ)POS1=POS2
11400		IF(R(1,K-1).GT.2.)GO TO 73
11450		IF(K.EQ.1)GO TO 73
11475		IF(RE.EQ.4.)GO TO 73
11500		Z=Z+RD/3.
11600	C   RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
11700		POS1=POS1-RD/3
11800	C  THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
11900	73	R(3,K)=POS1
12000	72	POS1=POS1+RD
12100	C   ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
12200		GO TO 337
12300	
12400	C  40???   50????  WHY NOT 100?
12600	71	DO 74 J=KZ,80
12700	74	IF(RE.EQ.-RPOS(2,J))GO TO 75
12800		POS=R(3,K-1)+4
12900		GO TO 76
13000	75	POS=RPOS(1,J)
13100		KZ=J+1
13200	C  FOUND SAME TYPE OF ITEM.
13300	76	R(3,K)=POS
13400		GO TO 337
13500	
13600	2	JX=JX+1
13700	21	AB=V(JX)
13800		IF(RE.EQ.2)V(JX)=-AB
13900	C  SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
13910		J=9
13920		IF(RE.EQ.2)J=7
14000		IF(R(8,K).GE.-1.)R(J,K)=AB
14100	C  STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
14200		IF(AB.GT..05)GO TO 210
14300		R(3,K)=-1.
14400		RA=100
14500		T=R(4,K)
14600		IF(T)RA=-RA
14700		R(4,K)=T+RA
14800		R(8,K)=1000
14900	C  1000 IN P8 PUTS IN SLASH ON TAIL
15000	C  FOUND A GRACE NOTE  (88TH NOTE)
15010		RA=R(5,K)
15020		IF(RA.GE.20)R(5,K)=RA-10.
15030		IF(RA.LT.20)R(5,K)=RA+10.
15040	C  TURNS STEM OVER.
15050		R(7,K)=1
15100		IF(JSET)GO TO 337
15125		AB=.125
15150	C IT USED TO JUMP.  NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
15200	210	RB=0
15300	CC	IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
15400	C  FOR AUTOMATIC SETUP
15500		JZ=K
15600	C  JZ WILL BE USED NEAR END
15710	3634	IF(AMOD(AB,.1875).EQ.0)GO TO 122
15755		IF(AMOD(AB*10.,1.5).EQ.0)GO TO 122
15800	C  .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
15900		IF(AMOD(AB,.4375).NE.0)GO TO 22
16050		T=20
16100		GO TO 322
16250	122	T=10
16300	322	IF(RE.EQ.2.)GO TO 35
16450		R(7,K)=T
16500	C  PUTS ONE OR TWO DOTS
16600	C  DOTS THE NOTE.
16700		GO TO 36
16800	
16900	35	R(6,K)=T/10.
17000	C  ADDS DOT TO REST.
17100	36	RB=AB/3.
17200		IF(T.NE.1)RB=(4*AB)/7
17300	C  TO KEEP TAIL ON DOTTED NOTE
17400	
17500	22	POS=POS1
17600		IF(JSET.EQ.0)GO TO 220
17700	
17800	C  NEXT IS FOR SETUP
17900	222	IF(NOTE)GO TO 223
18000	C  FIRST TIME A NOTE IS FOUND.
18100		NOTE=-1
18200		POS1=RLPOS
18300		Z=POS2-POS1
18400	C  RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
18500	223	IF(POS1.LT.AVP2)GO TO 221
18600	224	KX=KX+1
18700	C???? OCT, 73	 	IF(NX.EQ.0)GO TO 225
19000		IF(NX)RLP2=RPOS(1,KX)
19100		NX=-1
19200	225	IF(RPOS(2,KX-1))GO TO 227
19300		RLPOS=RPOS(1,KX-1)
19400		AVGPOS=AVP2
19500	227	AVP2=RPOS(2,KX)-.001
19600		IF(AVP2.GT.0)GO TO 223
19700	C  0 IN RPOS=POS. OF NON-NOTE
19800	CC****** WHY NEEDED?? 6/74 ***	IF(RLP2.GE.POS1)NX=0
19900		NX=0
20000	CC*****↑↑↑↑ CHANGED FROM ABOVE ***  6/74
20100		GO TO 224
20200	221	POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
20400	220	R(3,K)=POS
20800	4634	IF(RE.NE.1)GO TO 44
20805		IF(POS.EQ.POSNT(NTC))GO TO 2634
20807	C  SKIPS OTHER CHORD NOTES.
20810		NTC=NTC+1
20820		POSNT(NTC)=POS
20830	C  SAVES IT FOR NUMBS ABOVE NOTES, ETC.
20850	2634	IF(AB.GE.2)GO TO 4
20875		IF(AB.EQ.1.333333333)GO TO 4
20900	44	L=K+1
21000		IF(R(8,L).GE.0)GO TO 1634
21050		IF(R(1,L).NE.1.)GO TO 1634
21100	C   JUMP IF NOT DOUBLE STOP
21300	C  DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
21400		R(3,L)=R(3,K)
21500		K=L
21700	CC	R(8,K)=0
21800		GO TO 3634
21900	C  LOOPS BACK TO PICK UP MORE CHORD NOTES
22000	
22100	C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
22200	4	RA=-R(6,K)
22300		IF(RA.EQ.0)RA=-1
22400		IF(AB.LT.4.)GO TO 144
22500		R(7,K)=R(7,K)+1
22600	C  +1=WHOLE NOTE WILL PRINT 
22700		RA=-2.
22800	144	R(6,K)=RA
22900		GO TO 44
23000	
23100	1634	T=POS1
23110		RP=AB
23120		IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
23130	C  FOR PSUEDO-FIB. SPACING
23140		POS1=RP/Y*Z+POS1
23200	CF	POS1=AB/Y*Z+POS1
23300	CZ	GO TO 1636
23400	CZ	IF(JSET)GO TO 1636
23500	CZ	RP=6.
23600	CZ	IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
23700	C  3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
23800	CZ	RA=POS1-T
23900	CZ	RSTX=RP*RSTJ3
24000	CZ	IF(RA.GT.RSTX)GO TO 1636
24100	C  JUMP IF NOTES ARE FAR ENOUGH APART
24200	CZ	RA=RSTX-RA
24300	C  THE DIFFERENCE
24400	CZ	Z=Z-Z*RA/(POS2-POS1)
24500	C  REDUCES TOTAL SIZE Z 
24600	CZ	POS1=T+RSTX
24650	1636	IF(ABS(R(4,K)).GE.100.0)GO TO 337
24675	C  LEAVE TAILS ON GRACE NOTES ALONE.
24700		T=0
24800		RA=AB-RB
24810		IF(RA.EQ.4./6.)GO TO 535
24815		IF(RA.EQ.4./7.)GO TO 535
24817		IF(RA.GT..75)GO TO 535
24820	C  KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
24900		DO 534 N=1,4
25000	534	IF(RA.LE.RHY(N))T=N
25300	C  DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
25400	535	IF(R(1,JZ).EQ.1.)GO TO 334
25500		R(4,JZ)=0
25600	C  SETS REST
25700		IF(AB.GE.2)T=-1
25800		IF(AB.GE.4)T=-2
25900	C  WON'T DO DOUBLE DOTTED WHOLE NOTES.
26000		R(5,JZ)=T
26100		GO TO 337
26200	C*******  4/74  NEW WAY TO FIND TAILS
26300	C  OMITS RESTS  (REALLY???)
26400	334	R(7,JZ)=T+R(7,JZ)
26500	337	IF(K.LT.IZ)GO TO 3
26600		DO 335 K=IZ,1,-1
26700		IF(R(3,K).GE.0)GO TO 335
26800		IF(K.NE.IZ)GO TO 336
26900		R(3,K)=POS2-4.
27000		GO TO 335
27010	336	N=K-1
27020	1336	RA=R(3,N)
27030		IF(RA.GT.0)GO TO 2336
27040		N=N-1
27050		GO TO 1336
27060	C GO BACK IF MORE GRACE NOTES.
27065	2336	T=R(3,K+1)
27070		RB=T-RA
27075		RA=3
27080		IF(RB.LE.3)RA=RB/3.
27190		R(3,K)=T-RA
27200	335	CONTINUE
27300		K=0
27400	45	K=K+1
27500	C  NEXT IS TO ARRANGE DOTS.
27600		IF(R(7,K).LT.10)GO TO 451
27700		RA=R(3,K)
27800		DO 452 M=K+1,IZ
27900		IF(R(3,M).NE.RA)GO TO 453
28000	C  JUMP IF NOT CHORD NOTE.
28100		IF(ABS(R(6,M)).LT.30.)GO TO 452
28200	C  JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
28300		IF(R(4,M)-R(4,M-1).NE.2)GO TO 452
28400		IF(AMOD(R(4,M),2.).NE.0)R(7,M)=AMOD(R(7,M),10.)
28500	C  TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
28600	452	CONTINUE
28700	453	K=M-1
28800	451	IF(K.LT.IZ)GO TO 45
28900	
28910		N=IZ
29000		IF(JSET)GO TO 13
29050	CC	IF(SET4.GE.0)GO TO 13
29100	CC	M=IZ
29200	CC	RA=-1
29300	CC	DO 23 K=1,IZ
29400	CC	M=M+1
29500	CC	IF(R(3,K).EQ.RA)GO TO 177
29550	CC	IF(ABS(R(4,K)).LT.100)GO TO 123
29600	CC177	M=M-1
29700	CC	GO TO 23
29800	CC123	RA=R(3,K)
29900	C  TO CATCH DBL STOPS AND MINI-NOTES
30000	CC	DO 323 L=1,9
30100	CC323	R(L,M)=R(L,K)
30200	CC	R(2,M)=4
30600	CC23	CONTINUE
30700	CC	IZ=M
30800	C ABOVE SETS UP STAFF 4 IF IT WASN'T ALREADY
30810	13	NTC=NTC+1
30820		POSNT(NTC)=POS2
30860		POSNT(0)=POZ1
30900		IF(IREAD)RETURN
31000		DIMENSION ISU(390)
31100		COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
31200		1  /POSI/STFF(-3/4),JJ2,POSQ /FRMT/FQZ(3),IREAD
31300		EQUIVALENCE (J5,JQ(2)),(ISU,ST(3600))
31400		CALL DPYSET(3,ISU,390)
31500		CALL DPYBRT(6)
31550		J2=STAFF
31575		POSQ=STFF(J2)
31600		J5=1
31700	CC	RA=-100
31800		R4=20
31900	C  R5=0=1  STANDARD SIZE IS USED.
32000		DO 131 K=1,NTC-1
32100	CC	IF(R(1,K).NE.1)GO TO 131
32125	CC	IF(R(3,K).EQ.RA)GO TO 131
32150	CC	RA=R(3,K)
32200	CC	R3=RHORZ(RA)
32210		R3=RHORZ(POSNT(K))
32300		CALL PNUM
32400	C  GOES TO DRAW A NUMBER OVER A NOTE
32500		J5=J5+1
32600		IF(J5.EQ.10)J5=0
32700	131	CONTINUE
32800	132	CALL DPYOUT(3)
32900		CALL SETPOG(1)
33000		END
33100	
33200	C  SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
33300		SUBROUTINE SETUP
33400	      COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
33500		1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
33600		COMMON /PTR/PWDS(250),ITEM,L,I,IX
33700		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
33800		EQUIVALENCE (RA,RN(3919)),(ENDP,RN(3922)),(SETFLG,RN(3921))
33900		1,(SET4,RN(3920))
34000	
34100	C  RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
34300		SETFLG=-1
34400	C  THIS SENDS INFO TO SUBR. NOTES
34510		IF(SET4.GT.4)RETURN
34555	C  **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
34600		JX=0
34650	CC	RNL=0
34700		RA=0
34800		DO 9534 K=1,ITEM
34900		L=PWDS(K)
35000	      IF(RN(L+2).NE.SET4)GO TO 9534
35100		RD=RN(L+1)
35200		IF(RD.LT.5)GO TO 5
35300		IF(RD.LT.17)GO TO 9534
35350	5	IF(RD.NE.1)GO TO 6
35400		IF(RN(L+8).EQ.1000.)GO TO 9534
35410	C SKIPS MINI-NOTES
35425		IF(RN(L).LT.7)GO TO 9534
35427		GO TO 7
35437	C  SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
35480	6	IF(RD.NE.3)GO TO 8
35500		IF(RN(L+5).GT.3)GO TO 9534
35520	C  SKIPS IF NOT A REAL CLEF
35540		GO TO 7
35560	8	IF(RD.NE.4)GO TO 7
35580		IF(RN(L).GT.2)GO TO 9534
35600	C  SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
35700	7	JX=JX+1
35800		RPOS(1,JX)=RN(L+3)
35900		IF(RD.GT.2)GO TO 3
36200	C JUMP WHEN TIME VALUES ARE IN P8
36400		IF(RD.EQ.1)M=9
36410		IF(RD.EQ.2)M=7
36441		RC=RN(L+M)
36473	C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
38200	277	RA=RA+RC
38300	C  SUM OF RHYTHS
38400		GO TO 77
38800	3	RC=-RD
38900	77	RPOS(2,JX)=RC
39000	C  RC IS RHYTHMIC VALUE OF NOTE.
39100	9534	CONTINUE
39200	C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
39300	C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
39325		IF(RA.EQ.0)RETURN
39350	C  RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF. 
39400	
39500		CALL SORT2(RPOS,JX)
39600		ENDP=200.
39700		IF(RPOS(2,JX))ENDP=RPOS(1,JX)
39800		DO 1 L=1,JX
39900	1	IF(RPOS(2,L).GT.0)GO TO 4
40000	4	RD=RPOS(1,L)
40100		RB=ENDP-RD
40200	C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
40300		RC=RPOS(2,L)
40400		RPOS(2,L)=RD
40500	C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
40600		DO 2 K=L+1,JX
40700		RE=RPOS(2,K)
40800		IF(RE)GO TO 2
40900		RD=RC/RA*RB+RD
41000		RC=RE
41100		RPOS(2,K)=RD
41200	2	CONTINUE
41300	C  1,K=REAL POS.    2,K=AVERAGED POS.
41400	C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
41500		JX=JX+1
41600		RPOS(1,JX)=ENDP
41700		RPOS(2,JX)=ENDP
41800		SETFLG=0
41900	C  THIS FOR NOTES AND RHYTH
42000		END
42100	
42200		SUBROUTINE MARKS(RA)
42300		COMMON/ALF/INP(72),ML
42400		DIMENSION MKS(13)
42500		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R'/
42600		EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
42610		1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10))
42700		RA=99
42800		DO 16 JM=1,72
42900	16	IF(INP(JM))GO TO 17
43000	C  DIDN'T FIND  MORE LETTERS
43100		RETURN
43200	17	N=INP(JM)
43300		ML=INP(JM+1)
43400		M=INP(JM+2)
43500		DO 1 K=1,13
43600	1	IF(N.EQ.MKS(K))GO TO 2
43700	C  DID NOT FIND A LETTER
43800		RETURN
43850	C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
43862	C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
43871	C 16=AR(SIS),17=MO(RDANT)
43881	C 18=I(NVRTD MORD), ---,20=TR(ILL), >39=PPP, PP, CRESC., ETC.
43885	C 80=ACC(EL.)
43900	2	GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81),K
44005	12	IF(ML.EQ.'L')GO TO 120
44010	C  ↑↑↑ PLUS
44012		IF(N.EQ.MF)GO TO 121
44015		RA=42
44020		IF(ML.NE.MP)GO TO 18
44025		RA=41
44030		IF(M.EQ.MP)RA=40
44035	C  FOR P, PP, PPP  -- 42, 41, 40
44040		GO TO 18
44050	15	IF(ML.EQ.MI)GO TO 82
44075		K=K+1
44100	120	K=K+3
44200	8	RA=K
44300	C  YOU CAN TYPE # OR NAME OF MARK
44400	18	DO 6 JM=1,72
44500		N=INP(JM)
44600		INP(JM)=' '
44700	C  BLANKS OUT USED LETTERS
44800		IF(N.EQ.'/')RETURN
44825		IF(N.EQ.'*')RETURN
44837	6	IF(N.EQ.';')RETURN
44850	4	IF(ML.EQ.'O')GO TO 20
44900		RA=43
44950		IF(ML.EQ.MF)RA=50
45000	C  ↑↑↑↑↑ MP, MF
45050		GO TO 18
45205	121	IF(ML.EQ.'E')GO TO 120
45210	C  ↑↑↑  FERMATA
45215		RA=51
45220		IF(ML.NE.MF)GO TO 18
45225		RA=52
45230		IF(M.EQ.MF)RA=53
45235	C  F, FF, FFF  -- 51, 52, 53
45240		GO TO 18
45300	CC5	K=14
45400	CC	GO TO 8
45410	10	IF(ML.EQ.MC)GO TO 84
45500		IF(ML.NE.MR)GO TO 120
45550	19	K=13
45600	C  'R' FOR ARSIS
45700		GO TO 120
45800	11	IF(ML.EQ.MH)K=12
45900	C THESIS
45950		IF(ML.EQ.MR)K=17
46000		GO TO 120
46010	20	K=17
46020		GO TO 8
46030	21	K=18
46040		GO TO 8
46042	80	IF(ML.EQ.'+')GO TO 85
46043	C  FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
46044		IF(ML.EQ.'-')GO TO 86
46065		RA=70
46067	C  CRESC.
46070		GO TO 18
46072	85	RA=200
46074		GO TO 18
46076	86	RA=199
46078		GO TO 18
46080	81	RA=37
46090	C  RIT.
46100		GO TO 18
46110	82	RA=82
46120	C   DIM.
46125		GO TO 18
46130	84	RA=80
46140	C  ACCEL.
46150		GO TO 18
46160		END
46200	
46300		SUBROUTINE DOTS(L,Z,X,RC)
46400	C  M=BASIC RHY.  NX=NUM OF DOTS
46500		COMMON /XRN/RN(4000)
46600		RC=4./2.**(Z+2.)
46700		IF(RN(L).LT.4)RETURN
46750		IF(X.EQ.0)RETURN
46800	C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
46900		B=RC
47000		DO 100 NN=1,IFIX(X)
47100		B=B/2
47200	100	RC=RC+B
47300		END